perm filename DISTO.F4[DRW,LCS] blob sn#525288 filedate 1980-07-23 generic text, type T, neo UTF8
	DIMENSION I(4),II(4),JIN(3,14000)
	COMMON/D/ JD(4000),ID(3,40000)  /JJJJ/JP,KP,XS,YS
	COMMON NMOUT/OUTER/LFT,RT,TOP,BOT
	INTEGER X1,X2,Y1,Y2,LFT,RT,TOP,BOT
	EQUIVALENCE (X1,I(2)),(Y1,I(3)),(X2,II(2)),(Y2,II(3)),(J,I(4))
	1,(JJ,II(4))
	DATA IFIRST/0/
1	FORMAT(' TYPE INPUT NAME  '$)
2	FORMAT(' TYPE OUTPUT NAME  '$)
3	FORMAT(A5)
4	FORMAT(' TYPE FUNC NAME  '$)
6	FORMAT(4I)
81	FORMAT(2I,2F)
66	FORMAT(5X,4I)
80	FORMAT(' X POS, Y POS, X SIZE, Y SIZE '$)
	IF(IFIRST)GO TO 95
C DOESN'T READ DATA FILE AFTER 1ST TIME.
	IFIRST=-1
	TOP=-9999
	BOT=-TOP
	LFT=BOT
	RT=TOP
	TYPE 1
	ACCEPT 3,NMIN
C	TYPE 2
C	ACCEPT 3,NMOUT
	CALL IFILE(21,NMIN)
	NNN=1
C82	READ(21,6,END=95)NNN,(JIN(K,NNN),K=1,3)
82	READ(21,6,END=95)NN,(JIN(K,NNN),K=1,3)
	NNN=NNN+1
	GO TO 82
C	CALL OFILE(22,NMOUT)
95	NN=0
	NX=0
	NNN=NNN-1
	TYPE 80
	ACCEPT 81,JP,KP,XS,YS
	IF(XS.EQ.0)XS=1
	IF(YS.EQ.0)YS=1
5	CALL SHFT(I,JIN,NX)
C5	READ(21,6)I
C	X1=X1*XS+.5
C	Y1=Y1*YS+.5
C	TYPE 66,I
7	IF(NX.EQ.NNN)GO TO 100
	CALL SHFT(II,JIN,NX)
C7	READ(21,6,END=100)II
C	X2=X2*XS+.5
C	Y2=Y2*YS+.5
C	TYPE 66,II
99	IF(JJ.EQ.0)GO TO 13
98	CALL NNO(NN)
	I(1)=NN
	ID(1,NN)=X1
	ID(2,NN)=Y1
	ID(3,NN)=J
C	WRITE(22,6)I
C	TYPE 6,I
	GO TO 8
13	M=1
	K=X2-X1 
	KK=K
	IF(K.GE.0)GO TO 10
	M=-1
	KK=-K
10	L=Y2-Y1 
	MM=1
	LL=L
	IF(L.GE.0)GO TO 11
	MM=-1
	LL=-L
11	IF(LL.GT.KK)GO TO 12
	IF(KK.LT.2)GO TO 98
	DO 9 N=X1,X2-M,M
	A=N-X1
	B=K
	NY=Y1+L*A/B+.5
	CALL NNO(NN)
C	TYPE 6,NN,N,NY,J
	ID(1,NN)=N
	ID(2,NN)=NY
	ID(3,NN)=J
C	WRITE(22,6)NN,N,NY,J
9	J=0
8	X1=X2
	Y1=Y2
	J=JJ
	GO TO 7
12	IF(LL.LT.2)GO TO 98
	DO 19 N=Y1,Y2-MM,MM
	A=N-Y1
	B=L
	NY=X1+K*A/B+.5
	CALL NNO(NN)
C	TYPE 6,NN,NY,N,J
C	WRITE(22,6)NN,NY,N,J
	ID(1,NN)=NY
	ID(2,NN)=N
	ID(3,NN)=J
19	J=0
	GO TO 8
C100	WRITE(22,6)II
100	CALL NNO(NN)
	DO 96 K=1,3
96	ID(K,NN)=II(K+1)
	ID(3,NN+1)=-1
	CALL DSTO(LFT,RT)
101	CALL DPY  
	N=0
102	N=N+1
	J=ID(3,N)
	IF(J.GT.1)GO TO 102
C SKIP UNNEEDED LINES.
	IF(J)GO TO 104
	WRITE(22,103)N,(ID(K,N),K=1,3)
	GO TO 102
104	END FILE 22
	GO TO 95
103	FORMAT(4I6)
	END